Option Explicit
Sub K_Sample012()
    Dim myRng  As Range
    Dim myAr() As Variant
    Dim myCnt  As Long
    Dim myTmp  As Long
    Dim I      As Long
    Dim J      As Long
    Dim myFlg  As Boolean
    myCnt = 3000							'}Cn
    ReDim myAr(1 To myCnt)
    Set myRng = Worksheets.Add.Cells(1, 1)
    '}Cs@P
    For I = 1 To myCnt
        Randomize
        myAr(I) = Int((myCnt * 5) * Rnd + 1)
        myRng.Cells(I) = myAr(I)
    Next
    myAr = E_Sample012_1(myAr)
    With myRng.Offset(, 3)
        For I = 1 To myCnt
            .Cells(I) = myAr(I)
        Next
    End With
    MsgBox "Ƨǧ"
    Set myRng = Nothing						'
End Sub

Function E_Sample012_1(myAr As Variant) As Variant
    Dim myTmp   As Long
    Dim myAr1() As Long
    Dim myAr2() As Long
    Dim myCntr  As Long
    Dim myUbnd  As Long
    Dim I       As Long
    Dim J       As Long
    Dim k       As Long
    Dim Cdata   As Long
    myUbnd = UBound(myAr)
    myCntr = myAr((myUbnd) \ 2 + 1)
    I = 0: J = myUbnd + 1
    Do
        Do
            I = I + 1
        Loop While myAr(I) < myCntr
        Do
            J = J - 1
        Loop While myAr(J) > myCntr
        If I >= J Then Exit Do
        myTmp = myAr(J)
        myAr(J) = myAr(I)
        myAr(I) = myTmp
    Loop
    I = I - 1
    'eb
    ReDim myAr1(1 To I) As Long
    For k = 1 To I
        myAr1(k) = myAr(k)
    Next
    If I > 1 Then
        myAr1 = E_Sample012_1(myAr1)
    End If
    'b
    ReDim myAr2(1 To myUbnd - I) As Long
    For k = 1 To myUbnd - I
        myAr2(k) = myAr(k + I)
    Next
    If myUbnd - I > 1 Then
        myAr2 = E_Sample012_1(myAr2)
    End If
    'XփW
    For k = 1 To I
        myAr(k) = myAr1(k)
    Next
    For k = 1 To myUbnd - I
        myAr(k + I) = myAr2(k)
    Next
    E_Sample012_1 = myAr
    Exit Function
End Function
